home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacWorld: Complete Mac Interactive
/
Macworld Complete Mac Interactive CD)(1994).iso
/
The Best of BMUG
/
Utilities
/
Text and Speech
/
Alpha.5.76
/
Tcl
/
ElectricAlias
/
electricAlias.tcl
Wrap
Text File
|
1994-06-28
|
25KB
|
785 lines
# FILE: electricAlias.tcl
#
# LAST UPDATE: 01/25/93 2:41:51 PM
#
# This file contains the following TCL procedures:
#
# electricAlias-version -- returns the current version of electricAlias
# electricAlias-help -- opens 'electricAlias help' read-only
# electricAlias-on -- turns on (enables) electricAlias-insert
# electricAlias-off -- turns off (disables) electricAlias-insert
# electricAlias-mode -- set/list current electricAlias mode
# electricAlias-def -- creates an electricAlias definition
# electricAlias-var -- creates an electricAlias variable
# electricAlias-exists -- returns true/false
# electricAlias-list -- returns a list of electricAlias definitions
# electricAlias-names -- returns a list of active electricAliases
# electricAlias-idefine -- interactive define
# electricAlias-iundefine -- interactive undefine
# electricAlias-removeall -- removes all electricAlias definitions
# electricAlias-undefine -- removes an electricAlias definition
# electricAlias-insert -- on-the-fly template insertion (the real guts of this thing)
# electricAlias -- for compatibility with old version
# getAlias -- returns a specific current alias definition
# nextStop -- finds the next template stop
# prevStop -- finds the previous template stop
# askalias -- prompts the user for a value to set an alias variable
# changeMode -- new version to enable electricAlias (renames old
# version to 'original-changeMode')
#
# 'electricAlias-insert' (bound to TAB) provides automatic template/aliasing on the fly.
#
# For documentation, see 'electricAlias help'. For examples, see 'aliases'.
#
# To use, simply place this file place in a folder named $HOME:Tcl:electricAlias:
# and add 'source $HOME:Tcl:electricAlias:electricAlias.tcl' to AlphaBits.tcl.
# Also create a folder named $HOME:TCL:electricAlias:Aliases and make sure to place
# at least a file named 'Aliases' in it with your default aliases.
# If you wish to use the language extensions feature, place respective
# files 'Aliases.Tcl', 'Aliases.C', etc.. there as well.
#
# IMPORTANT NOTE
# *********************************************************************
# * When changing to a mode for the first time in an Alpha session *
# * (e.g. editing a C program), there may be a noticable delay as the *
# * appropriate aliases are loaded. This is done rather than loading *
# * everything at startup to save memory and startup time. This only *
# * occurs once per session per mode. *
# *********************************************************************
#
#
# SEE ALSO unknown.tcl, date.tcl, update.tcl, number.tcl
#
################################################################################
# COPYRIGHT:
#
# Copyright © 1992,1993 by David C. Black
# All rights reserved.
#
# Redistribution and use in source and binary forms are permitted
# provided that the above copyright notice and this paragraph are
# duplicated in all such forms and that any documentation,
# advertising materials, and other materials related to such
# distribution and use acknowledge that the software was developed
# by David C. Black.
#
# THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
################################################################################
# AUTHOR
#
# David C. Black
# Internet: black@mpd.tandem.com (preferred)
# GEnie: D.C.Black
# USnail: 6217 John Chisum Lane, Austin, TX 78749
#
################################################################################
# HISTORY
#
# modified who rev reason
# -------- --- --- ------
# 01/25/93 DCB 1.8 Execute 'activateHook' after loading
# Now use electricAlias-changemode instead of original-changemode
# 01/23/93 DCB 1.7 Changed default locations
# Split electricAlias into multiple specialized proc's
# 01/06/93 DCB 1.6 Removed electricEnter, date, update, number to
# separate .tcl files
# Simplified installation
# Added weekday, month, day, year to date proc
# Fixed electricEnter & §«TCL_COMMAND» to work at global level
# Changed bind to TAB
# Added electricAlias help sub-command
# 'delete' now requires MODE
# 'add' renamed to 'interactive-add'
# 'remove' renamed to 'interactive-remove'
# 'list','names' & 'removeall' now allow restriction to a particular mode
# 'define' & 'variable' now return definition if not provided
# Added askalias proc for use in definitions
# Added getAlias proc
# •-templates now require that they also be at end of line
# Corrected \b\b && ^\b substitutions
# Modified temporary marks to be window specific
# Added 'update' proc
# 11/23/92 DCB 1.5 Included definition of 'nextStop' proc
# Changed 'stop's to 'st•p's to avoid collisions with permanent marks
# aliasmode is now forced to lowercase
# 'electricAlias mode' without arg now 'return's the mode
# Added 'electricAlias removeall' command
# Fixed 'electricAlias list' bug with variables
# Nil-mode alias variable now treated as global
# Reversed ordering of HISTORY
# 11/18/92 DCB 1.4 'electricAlias mode' now uses/require MODE argument
# Modified 'date' proc
# 11/17/92 DCB 1.3 Fixed nasty missing \] in §«TCL_COMMAND»
# 11/16/92 DCB 1.2 Prevent • from appearing in variable mode definitions
# §«TCL_COMMAND» now does each invocation separately
# §«TCL_COMMAND» now uses [eval]
# One minor typo
# Non-• templates are now recognized at the beginning of a line
# electricEnter now inserts in the correct window
# Documented 'date' proc & added 'number' proc (useful in aliases)
# Minor comment editing/formatting
# 11/15/92 DCB 1.1 Added {version} command
# Code to sub \n for \r in {define} and {variable}
# Limit variable substitutions to 99 per template (avoid infinite)
# Limit • mode templates to non-nil major modes
# Added electric commands §«TCL_COMMAND»
# 11/14/92 DCB 1.0 Original
################################################################################
# DESIGN NOTES
#
# electricAlias uses a single array ALIAS to store all of its data. Aliases
# themselves are stored as ALIAS(mode,name). This means that commas are not
# allowed in mode names (not a severe restriction). State information is
# stored in ALIAS(name).
#
# To make it easier to undo an unintentional template, insertText is called
# once with the normal insertion of a space. If a template succeeds, then the
# matched word is replaced. To get back to the plain insertion, just UNDO
# (CMD-Z) twice! To undo all the way you need one more undo.
#
# Also, if text is selected then the template checking is always abandoned
# in favor of a real space.
#
# WARNING: If binding to another key is desired, be sure to change the
# definition of $bindKey appropriately.
#
# Use of the bullet (•) to flag stops was arbitrary to some extent. It had
# to be something easy to use, but not a normal part of programming languages.
# It also needed to be something that would not need special escaping in a
# regular expression. The same is true for alias variables.
#
################################################################################
# IDEA/REQUEST/TODO
#
# electricFunc -or- How to recognize procedural definitions on the fly so
# that later instantiations/calls can automatically insert the correct
# template? This should be extensible to several languages.
#
# For example in C, I can define 'int max(int a,int b) { return a>b ? a : b }'.
# Later when I type 'x = max(', I would get 'x = max(a,b)' with 'a,b'
# automatically selected.
#
# In Verilog, this is complicated by name parameters. For example a definition:
# 'module myAnd (y,a,b); input a,b; output y; assign y = a & b; endmodule'
# should be instantiated with 'myAnd THIS1(.a(a_wire),.b(b_wire));'.
#
# The justification for the entire electricFunc concept is that frequently
# modules may have literally tens of connections and leaving one out or
# misnaming can be disasterous. The same happens occasionally in C or you
# forget the names of the parameters (more likely).
#
################################################################################
#message "Loading electricAlias.tcl"
# Define global array for state/alias data
if {[info exists ALIAS(active)] == 0} {
if {[info exists ALIAS] == 1} {
# Its scalar and we need an array
unset ALIAS
}
set ALIAS(active) 1
set ALIAS(mode) "tcl"
set ALIAS(modes) {tcl,}
}
#
################################################################################
proc electricAlias-version {} {
return "electricAlias version 1.8"
}
#endproc electricAlias-version
##############################################################################
proc electricAlias-help {} {
set helpDirs {$HOME:Help $HOME}
set helpFile "electricAlias Help"
foreach helpDir $helpDirs{
if {[file exists $helpDir:$helpFile} {
edit -r -m $helpDir:$helpFile
return
}
}
}
#endproc electricAlias-help
##############################################################################
proc electricAlias-on {} {
global ALIAS
set ALIAS(active) 1
}
#endproc electricAlias-on
##############################################################################
proc electricAlias-off {} {
global ALIAS
set ALIAS(active) 0
}
#endproc electricAlias-off
##############################################################################
proc electricAlias-mode {args} {
global ALIAS
set argc [llength $args]
set aliasmode $ALIAS(mode)
if {$argc > 1} {
error "Usage: electricAlias-mode ?NAME?"
}
if {$argc == 0} {
return $aliasmode
}
set aliasmode [string tolower [lindex $args 0]]
if {[regexp {[,]} $aliasmode]} {
error "Alias modes may not include commas"
}
set ALIAS(active) 1
regsub {^•} "$aliasmode" "" aliasmode
set ALIAS(mode) "$aliasmode"
if {[lsearch $ALIAS(modes) $aliasmode,] < 0} {
lappend ALIAS(modes) $aliasmode,
}
#message "Aliasmode $aliasmode"
}
#endproc electricAlias-mode
##############################################################################
proc electricAlias-def {args} {
global ALIAS
set aliasmode [string tolower [lindex $args 0]]
set argc [llength $args]
if {$argc < 2 || $argc > 3} {
error "Usage: electricAlias-def MODE NAME ?DEFINITION?"
}
set aliasmode [string tolower [lindex $args 0]]
if {[regexp {[,]} $aliasmode]} {
error "Alias modes may not include commas"
}
set name [lindex $args 1]
if {$argc == 2} {
return [getAlias $aliasmode $name]
}
set defn [lindex $args 2]
regsub -all "\n" $defn "\r" defn
set ALIAS($aliasmode,$name) $defn
if {[lsearch $ALIAS(modes) $aliasmode,] < 0} {
lappend ALIAS(modes) $aliasmode,
}
}
#endproc electricAlias-def
##############################################################################
proc electricAlias-var {args} {
global ALIAS
set aliasmode [string tolower [lindex $args 0]]
set argc [llength $args]
if {$argc < 2 || $argc > 3} {
error "Usage: electricAlias-var MODE NAME ?DEFINITION?"
}
set aliasmode [string tolower [lindex $args 0]]
if {[regexp {[,]} $aliasmode]} {
error "Alias modes may not include commas"
}
set name [lindex $args 1]
if {$argc == 2} {
return [getAlias $aliasmode $name]
}
set defn [lindex $args 2]
regsub -all "\n" $defn "\r" defn
set ALIAS($aliasmode,§\{$name\}) $defn
if {[lsearch $ALIAS(modes) $aliasmode,] < 0} {
lappend ALIAS(modes) $aliasmode,
}
}
#endproc electricAlias-var
##############################################################################
proc electricAlias-exists {args} {
global ALIAS
set argc [llength $args]
if {$argc != 2} {
error "Usage: electricAlias-exists MODE NAME"
}
set aliasmode [string tolower [lindex $args 0]]
set name [lindex $args 1]
return [info exists ALIAS($aliasmode,$name)]
}
#endproc electricAlias-exists
##############################################################################
proc electricAlias-list {args} {
global ALIAS
set argc [llength $args]
set aliasmode $ALIAS(mode)
if {$argc > 1} {
error "Usage: electricAlias-list ?MODE?"
}
if {$argc == 1} {
set theMode [string tolower [lindex $args 0]]
if {[regexp {[,]} $theMode]} {
error "Alias modes may not include commas"
}
} else {
set theMode ""
}
set list {}
set count 1
foreach name [array names ALIAS] {
incr count
set index [split $name ","]
if {[llength $index] >= 2} {
set name [join [lrange $index 1 end] ","]
set aliasmode [lindex $index 0]
if {$theMode == "" || $aliasmode == $theMode || "$aliasmode" == "•$theMode"} {
lappend list [getAlias $aliasmode $name]
}
}
}
#endforeach
return [join [lsort $list] "\r"]
}
#endproc electricAlias-list
##############################################################################
proc electricAlias-names {args} {
global ALIAS
set argc [llength $args]
set aliasmode $ALIAS(mode)
if {$argc > 1} {
error "Usage: electricAlias-names ?MODE?"
}
if {$argc == 1} {
set theMode [string tolower [lindex $args 0]]
if {[regexp {[,]} $theMode]} {
error "Alias modes may not include commas"
}
} else {
set theMode ""
}
set list {}
foreach name [array names ALIAS] {
set index [split $name ","]
if {[llength $index] < 2} {
continue
}
if {$theMode == "" || $aliasmode == $theMode || "$aliasmode" == "•$theMode"} {
lappend list "$name"
}
}
#endforeach
return [lsort $list]
}
#endproc electricAlias-names
##############################################################################
proc electricAlias-idefine {} {
global ALIAS
set aliasmode $ALIAS(mode)
set list [lsort $ALIAS(modes)]
catch {set name [eval [concat {prompt "Add mode,name:" "" Modes} $list]]}
if {[info exists name] == 0} { return }
if {$name == ""} { return }
if {[string first $name ","] < 0} {
set aliasmode [string range $name 0 [expr {$ind-1}]]
set name "$aliasmode,$name"
}
if {$name == ""} { return }
if {[info exists ALIAS($name)} {
if {[askyesno "Replace existing definition?"] != "Yes"} { return }
}
set defn [prompt "Definition of \"$name\":" ""]
if {$defn == ""} { return }
set ALIAS($name) $defn
message "Defined $name"
}
#endproc electricAlias-idefine
##############################################################################
proc electricAlias-iundefine {} {
global ALIAS
set list [electricAlias-names]
catch {set name [eval [concat {prompt {Remove mode,alias:} [lindex $list 0] Alias} $list]]}
if {[info exists name]} {
if {[string first $name ","] >= 0} {
unset ALIAS($name)
message "Removed $name"
unset name
}
}
}
#endproc electricAlias-iundefine
##############################################################################
proc electricAlias-removeall {args} {
global ALIAS
set argc [llength $args]
set aliasmode $ALIAS(mode)
if {$argc > 1} {
error "Usage: electricAlias-removeall ?MODE?"
}
if {$argc == 1} {
set theMode [string tolower [lindex $args 0]]
if {[regexp {[,]} $theMode]} {
error "Alias modes may not include commas"
}
} else {
set theMode ""
}
foreach name [array names ALIAS] {
if {[string first "," $name] >= 0} {
set aliasmode = [lindex [split $name ","] 0]
if {$theMode == "" || $aliasmode == $theMode || "$aliasmode" == "•$theMode"} {
unset ALIAS($name)
}
}
}
#endforeach
}
#endproc electricAlias-removeall
##############################################################################
proc electricAlias-undefine {aliasmode name} {
global ALIAS
set aliasmode [string tolower $aliasmode]
if {[regexp {[,]} $aliasmode]} {
error "Alias modes may not include commas"
}
if {[info exists ALIAS($aliasmode,$name)] == 0} {
error "electricAlias does not exist!"
}
unset ALIAS($aliasmode,$name)
}
#endproc electricAlias-undefine
##############################################################################
proc electricAlias-insert {args} {
global ALIAS
set aliasmode $ALIAS(mode)
set bindKey "\t"
set argc [llength $args]
if {$argc == 0} {
if {[getSelect] != "" } then {
replaceText [getPos] [selEnd] $bindKey
forwardChar
return
}
if {$ALIAS(active) == 0} {
insertText $bindKey
return
}
set match 0
set args [list normal]
set pos [getPos]
set bol [getText [lineStart $pos] $pos]
set eol [getText [expr {$pos}] [nextLineStart $pos]]
set modMode ""
# First token on the line?
if {! $match } {
if {[regexp {^([ ]*)([^ ]+)$} $bol all indent name]} {
if {[regexp "^\[ \]*\[\r\n\]?\$" $eol all]} {
set args [list insert "$indent" "$name"]
set modMode "•"
set match 1
}
}
}
# Word token?
if {! $match && [regexp {([ ]+)([^ ]+)$} "$bol" all indent name] == 1} {
set args [list insert "" "$name"]
set match 1
}
insertText "$bindKey"
}
set cmnd [lindex $args 0]
set args [lreplace $args 0 0]
set argc [llength $args]
if {$cmnd == "normal"} {
return
}
set indent [lindex $args 0]
set name [lindex $args 1]
set match 0
# • mode template?
if {$match == 0 && $modMode == "•" && [info exists ALIAS($modMode$aliasmode,$name)] == 1} {
set defn "$ALIAS($modMode$aliasmode,$name)"
set match 1
}
# embedded word template?
if {$match == 0 && [info exists ALIAS($aliasmode,$name)] == 1} {
set defn "$ALIAS($aliasmode,$name)"
set match 2
}
# nil mode • definition matches everything iff non-nil aliasmode
if {$match == 0 && $modMode == "•" && $aliasmode != "" && [info exists ALIAS(•,$name)] == 1} {
set defn "$ALIAS(•,$name)"
set match 3
}
# nil mode matches everything
if {$match == 0 && [info exists ALIAS(,$name)] == 1} {
set defn "$ALIAS(,$name)"
set indent ""
set match 4
}
# Next line for debug:
#message "$modMode $aliasmode $name -> $match"
# return if no aliases found
if {$match == 0} {
return
}
# Perform substitutions
set limit 99
set doAnotherSubstitute 1
while {$doAnotherSubstitute} {
set doAnotherSubstitute 0
# substitute commands §«TCL_COMMAND»
while {[regexp {§«([^»]+)»} $defn all text] == 1} {
global _text
global _returnText
set _text $text
set _returnText ""
set errcode [uplevel #0 {catch $_text _returnText}]
if {$errcode != 0} {
set _returnText "§ERROR $errcode($_text->$_returnText)"
}
regsub {§«([^»]+)»} $defn $_returnText defn
set doAnotherSubstitute 1
if {[incr limit -1] <= 0} {
error "Too many electricAlias command substitutions"
}
unset _text
unset _returnText
}
#endwhile substitute cmds
# substitute vars §{NAME}
while {[regexp {§\{[A-Za-z0-9_-]+\}} $defn var] == 1} {
if {[info exists ALIAS($aliasmode,$var)] == 1} {
set repl $ALIAS($aliasmode,$var)
} else {
# Does a global version of the variable exist?
if {[info exists ALIAS(,$var)] == 1} {
set repl $ALIAS(,$var)
} else {
set repl ""
}
}
regsub -all $var $defn $repl defn
if {[info exists ALIAS($aliasmode,$var)] == 0 && [info exists ALIAS(,$var)] == 0} {
alertnote "No such electricAlias variable $var"
}
set doAnotherSubstitute 1
if {[incr limit -1] <= 0} {
alertnote "Too many electricAlias variable substitutions"
}
}
#endwhile substitute vars
}
#endwhile
# substitute indents
regsub -all "\r" "$defn" "\r$indent" defn
set bs ""
if {[regexp "^\b+" $defn bs]} {
regsub "^\b+" "$defn" "" defn
}
while {[regsub ".\b" "$defn" "" defn]} {
;
}
#endwhile
# insert text and set stops
set repl "$defn"
regsub -all "•" "$repl" "" repl
set epos [getPos]
set bpos [expr {$epos - [string length "$name"] - 1}]
if {"$repl" == "$defn"} {
# Assert no stops to mark
if {$bs == "" && [regexp "\[^\n\r\t \]$" $repl] == 1} {
append repl " "
}
replaceText $bpos $epos "$repl"
goto [expr {$bpos + [string length "$repl"]}]
return
}
if {$bs != "" && $indent != ""} {
incr bpos [expr {-[string length $bs]}]
}
replaceText $bpos $epos "$repl"
global stopRing
set stopRing {}
set repl "$defn"
set win [lindex [winNames] 0]
set i 1
while {[regexp -indices "•" $repl I] == 1} {
regsub "•" "$repl" "" repl
createTMark "${win}•stop$i" [expr {$bpos + [lindex $I 0]}]
lappend stopRing "${win}•stop$i"
incr i
}
#endwhile
gotoTMark "${win}•stop1"
bind 'j' <z> nextStop
bind 'j' <zs> prevStop
}
#endproc electricAlias-insert
bind '\t' electricAlias-insert
################################################################################
proc electricAlias {cmnd args} {
case {[llength $args]} {
{0} {electricAlias-$cmnd}
{1} {electricAlias-$cmnd [lindex $args 0]}
{2} {electricAlias-$cmnd [lindex $args 0] [lindex $args 1]}
{3} {electricAlias-$cmnd [lindex $args 0] [lindex $args 1] [lindex $args 2]}
}
#endcase
electricAlias-$cmnd $args
}
#endproc electricAlias
##############################################################################
proc getAlias {aliasmode name} {
global ALIAS
if {![info exists ALIAS($aliasmode,$name)]} {
alertnote "getAlias: ?$aliasmode $name?"
return ""
}
set repl "$ALIAS($aliasmode,$name)"
regsub -all "\r" "$repl" "\\r" repl
regsub -all "\n" "$repl" "\\n" repl
regsub -all "\t" "$repl" "\\t" repl
regsub -all "\b" "$repl" "\\b" repl
regsub -all {\$} "$repl" "\\\$" repl
regsub -all {\{} "$repl" "\\\{" repl
regsub -all {\}} "$repl" "\\\}" repl
regsub -all {\$} "$name" "\\\$" name
regsub -all {\{} "$name" "\\\{" name
regsub -all {\}} "$name" "\\\}" name
regsub -all {\[} "$name" "\\\[" name
regsub -all {\]} "$name" "\\\]" name
set cmnd "var"
if {[regexp {^§\\\{.*\}$} $name] == 0} {
set cmnd "def"
set name "\"$name\""
}
set fmt "electricAlias-%s %-8s %-10s \{%s\}"
return [format $fmt $cmnd "\"$aliasmode\"" $name $repl]
}
#endproc getAlias
################################################################################
proc nextStop {} {
global stopRing
set first [lindex $stopRing 0]
set stopRing [lreplace $stopRing 0 0]
lappend stopRing $first
set next [lindex $stopRing 0]
gotoTMark $next
}
#endproc nextStop
################################################################################
proc prevStop {} {
global stopRing
set end [expr {[llength $stopRing] - 1}]
set last [lindex $stopRing $end]
set stopRing [lreplace $stopRing $end $end]
set stopRing [linsert $stopRing 0 $last]
gotoTMark $last
}
#endproc prevStop
################################################################################
proc askalias {prompt name args} {
global mode
set argc [llength $args]
case $argc {
0 {
electricAlias-var $mode $name [prompt $prompt ""]
}
1 {
set default $args
electricAlias-var $mode $name [prompt $prompt $default]
}
{default} {
set default [lindex $args 0]
set title [lindex $args 1]
set list [lrange $args 2 end]
electricAlias-var $mode $name [prompt $prompt $default $title $list]
}
}
return ""
}
#endproc askalias
################################################################################
if {![file isdirectory "$HOME:TCL:electricAlias:Aliases"]} {
mkdir $HOME:TCL:electricAlias:Aliases
}
if {[file readable "$HOME:TCL:electricAlias:Aliases:Aliases"]} {
source $HOME:TCL:electricAlias:Aliases:aliases
} else {
alertnote "No default file $HOME:TCL:electricAlias:Aliases:aliases"
}
# NOTE: electricAlias-changeMode is the OLD version
# It was renamed to prevent collistion with anything else.
# Due to the way this must work, it seems like the names
# are backwards.
if {[info procs electricAlias-changeMode] != "electricAlias-changeMode"} {
rename changeMode electricAlias-changeMode
proc changeMode {newMode} {
electricAlias-changeMode $newMode
global mode
global HOME
if {![electricAlias-exists "•$mode" "•$mode"] &&
[file readable "$HOME:TCL:electricAlias:Aliases:aliases.$mode"]} {
source "$HOME:TCL:electricAlias:Aliases:aliases.$mode"
}
electricAlias-mode "$mode"
}
#endproc changeMode
}
#endif
################################################################################
set wins [winNames -f]
if {[llength $wins]} {
activateHook [lindex $wins 0]
}
#message ""